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-- file TreePack.Mesa 

— - last modified by Satterthwaite, April 25, 1978 8:39 AM 

DIRECTORY 

SystemDefs: FROM "systemdef s" , 
TableDefs: FROM "tabledef s" , 
LitDefs: FROM "litdefs", 
SymDefs: FROM "symdefs", 
TreeDefs: FROM "treedef s" ; 

TreePack: PROGRAM 

IMPORTS SystemDefs, TableDefs 
EXPORTS TreeDefs - 
PUBLIC 
BEGIN 
OPEN TreeDefs; 

endTreelndex: Treelndex ■ LAST[TreeIndex] ; 
EndMark: TreeLink ■ [subtree[index: endTreelndex]]; 

TreeSonField: TYPE ■ RECORD [soni: TreeLink]; -- for sequencing through sons 
TreeXIndex: TYPE - POINTER [0 . .TableDefs . Tabl eLimit) TO TreeSonField; 

treeOpen: PRIVATE BOOLEAN ♦- FALSE; 

TreeLinkStack: PRIVATE TYPE - DESCRIPTOR FOR ARRAY OF TreeLink; 

kStack: PRIVATE TreeLinkStack; 
kl: PRIVATE CARDINAL; 

tb: PRIVATE TableDefs . TableBase; -- tree base 

UpdateBase: PRIVATE TableDefs .TableNotif ier a 
BEGIN 

tb «- base[treetype]; RETURN 
END; 

Treelnit: PROCEDURE ■ 
BEGIN 

IF treeOpen THEN TreeErase[]; 
kStack <- AllocStack[100]; kl 4- 0; 
TableDefs.AddNotify[UpdateBase]; 

IF maketree[none,0] # empty THEN ERROR; -- reserve null 
treeOpen *- TRUE; RETURN 
END; 

TreeErase: PROCEDURE - 
BEGIN 

treeOpen «- FALSE; 

TableDefs.DropNotify[UpdateBase]; FreeStack[ kStack]; RETURN 
END; 

AllocStack: PRIVATE PROCEDURE [size: CARDINAL] RETURNS [s: TreeLinkStack] - 
BEGIN 

base: POINTER; 

base «- SystemDefs . AllocateSegment[size*SIZE[TreeLink]] ; 
s «- DESCRIPTOR[base, SystemDefs .SegmentSize[base]/SIZE[TreeLink]] ; 
RETURN 
END; 

FreeStack: PRIVATE PROCEDURE [s: TreeLinkStack] - 
BEGIN 

IF LENGTH[s] THEN SystemDefs . FreeSegment[BASE[s]]; 
RETURN 
END; 

ExpandStack: PRIVATE PROCEDURE [s: TreeLinkStack, delta: CARDINAL] 
RETURNS [t: TreeLinkStack] - 
BEGIN 

i: CARDINAL; 

t «- AllocStack[LENGTH[s]+delta]; 

FOR i IN [0 . . MIN[LENGTH[s], LENGTH[t]]) DO t[i] «- s[i] ENDLOOP; 
FreeStack[s]; RETURN 
END; 
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mlpush: PROCEDURE [v: TreeLink] ■ 
BEGIN 

IF kl >■ LENGTH[kStack] THEN kStack <- ExpandStack[kStack, 25]; 
kStack[kI] <- v; kl «- kl+l; 
RETURN 
END; 

mlpop: PROCEDURE RETURNS [TreeLink] ■ 
BEGIN 

RETURN [kStack[kI<-kI-l]] 
END; 

ml insert: PROCEDURE [v: TreeLink, n: CARDINAL] - 
BEGIN 

i: CARDINAL; 

IF kl >* LENGTH[kStack] THEN kStack <- ExpandStack[kStack, 25]; 
i <- kl; kl <- kl + l; 

THROUGH [1 .. n) DO kStack[i] <- kStack[i-l]; i <- i-1 ENDLOOP; 
kStack[i] <- v; 
RETURN 
END; 

mlextract: PROCEDURE [n: CARDINAL] RETURNS [v: TreeLink] - 
BEGIN 

i: CARDINAL; 

i «- kl - n; v «- kStack[i]; 

THROUGH [1 .. n) DO kStack[i] ♦- kStack[1+l]; i ♦■ 1+1 ENDLOOP; 
kl 4- kl - 1; 
RETURN [v] 
END; 

maketree: PROCEDURE [name: NodeName, count: INTEGER] RETURNS [TreeLink] 
BEGIN 

nSons: CARDINAL = ABS[count]; 

node: Treelndex - TableDef s .GetChunk[TreeNodeSize+nSons]; 
p: TreeXIndex; 
d: INTEGER; 

p <- LOOPHOLE[node + TreeNodeSize + (IF count<0 THEN ELSE nSons-1)]; 
d «- IF count<0 THEN 1 ELSE -1; 
THROUGH [1 .. nSons] 

DO (tb+p).soni «- kStack[kI«-kI-l]; p <- p + d ENDLOOP; 
(tb+node) .name «- name; ( tb+node) .nsons «- nSons; 
(tb+node) . info <- 0; 

(tb+node) .shared <- (tb+node) .attrl <- (tb+node) .attr2 «- FALSE; 
RETURN[TreeLink[subtree[ index: node]]] 
END; 

makelist: PROCEDURE [size: INTEGER] RETURNS [TreeLink] * 
BEGIN 

push! ist[size] ; 
RETURN [m1pop[j] 
END; 



pushtree: PROCEDURE [name: NodeName, count: INTEGER] 
BEGIN 

mlpush[maketree[name, count]]; 
RETURN 
END; 

pushlist: PROCEDURE [size: INTEGER] - 
BEGIN 

nSons: CARDINAL * ABS[size]; 
node: Treelndex; 
p: TreeXIndex; 
d: INTEGER; 
SELECT nSons FROM 
1 -> NULL; 
■> m1push[empty]; 
ENDCASE «> 
BEGIN 
IF nSons IN (0. .MaxNSons] 
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THEN 
BEGIN 

node <~ TableDefs.GetChunk[TreeNodeSize+nSons]; 
p «- LOOPHOLE[node + TreeNodeSize+(nSons-l)] ; 
END 
ELSE 
BEGIN 

node <- TableDefs.GetChunk[TreeNodeSize+(nSons+l)]; 
p «- LOOPHOLE[node + TreeNodeSize+nSons] ; 
(tb+p).soni ♦- EndMark; p <- p-1; 
END; 
IF size > 
THEN d «- -1 

ELSE BEGIN d ♦■ 1 ; p <- LOOPHOLE[node + TreeNodeSize] END; 
THROUGH [1 . . nSons] 

DO (tb+p).soni ♦- kStack[kI «- kl-l]; p ♦• p+d ENDLOOP; 
(tb+node) .name <- 1 ist; 
(tb+node) . info *- 0; 

(tb+node) .shared <- (tb+node) . attrl <- (tb+node) . attr2 «- FALSE; 
(tb+node) .nsons <- IF nSons IN (0. .MaxNSons] THEN nSons ELSE 0; 
ml pus h[TreeLink[subtree[ index: node]]]; 
END; 
RETURN 
END; 

pushproperlist: PROCEDURE [size: INTEGER] « 
BEGIN 

node: Treelndex; 
IF size -IN [-1..1] 
THEN pushlist[size] 
ELSE 

BEGIN 

node <- TableDefs.GetChunk[TreeNodeSize + 1]; 

(tb+node) .name *- list; 

(tb+node) . info ♦■ 0; 

(tb+node) .shared ♦• (tb+node) .attrl ♦- (tb+node) . attr2 ♦■ FALSE; 

(tb+node) .nsons <- ABS[size]; 

(tb+node) ,sonl <- IF size * THEN EndMark ELSE mlpop[]; 

ml push[TreeLink[subtree [index: node]]]; 

END; 
RETURN 
END; 



pushhashtree: PROCEDURE [hti: SymDef s .HTIndex] = 
BEGIN 

mlpush[TreeLink[hash[index: hti]]]; 
RETURN 
END; 

pushsymtree: PROCEDURE [sei: SymDef s .ISEIndex] » 
BEGIN 

ml push[TreeLink[ symbol [index: sei]]] ; 
RETURN 
END; 

pushlittree: PROCEDURE [lti: LitDef s . LTIndex] = 
BEGIN 

mlpush[TreeLink[literal[info: [word[l ti ]]]]]; 
RETURN 
END; 

pushstringlittree: PROCEDURE [sti: LitDef s .STIndex] » 
BEGIN 

mlpush[TreeLink[l iteral[info: [string[sti]]]]]; 
RETURN 
END; 



setinfo: PROCEDURE [info: UNSPECIFIED] ■ 
BEGIN 

v: TreeLink * kStack[kI-l]; 

WITH v SELECT FROM 

subtree -> IF index § nullTreelndex THEN ( tb+index) . info <- info; 

ENDCASE -> NULL; 
RETURN 
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END; 

setattr: PROCEDURE [attr: [1..Z], value: BOOLEAN] 
BEGIN 

v: TreeLink ■ kStack[kI-l]; 
WITH v SELECT FROM 
subtree ■> 

IF index ■ nullTreelndex 
THEN ERROR 
ELSE 

SELECT attr FROM 

1 ■> (tb+index) . attrl <- value; 

2 ■> (tb+index) .attr2 <- value; 
ENDCASE; 

ENDCASE «> ERROR; 
RETURN 
END; 



freenode: PROCEDURE [node: Treelndex] ■ 
BEGIN 

p: TreeXIndex; 
n: CARDINAL; 

IF node tt nullTreelndex AND ~(tb+node) . shared 
THEN 

BEGIN p <- LOOPHOLE[node + TreeNodeSize] ; 
IF (tb+node) .name # list OR (tb+node) .nsons # 
THEN 

BEGIN n ♦■ (tb+node) .nsons; 
THROUGH [1 . . n] 
DO 

WITH (tb+p).soni SELECT FROM 
subtree »> f reenode[index]; 
ENDCASE; 
P <~ p+l; 
ENDLOOP; 
END 
ELSE 

BEGIN n «- 1; 

UNTIL (tb+p).soni * EndMark 
DO 

WITH (tb+p).soni SELECT FROM 
subtree ■> f reenode[index] ; 
ENDCASE; 
n <- n+1; p «- p+l; 
ENDLOOP; 
END; 
TableDef s. FreeChunk[node, TreeNodeSize+n]; 
END; 
RETURN 
END; 

freetree: PROCEDURE [t: TreeLink] RETURNS [TreeLink] - 
BEGIN 
WITH t SELECT FROM 

subtree -> f reenode[index] ; 
ENDCASE; 
RETURN [empty] 
END; 



-- procedures for tree testing 

GetNode: PROCEDURE [t: TreeLink] RETURNS [Treelndex] - 
BEGIN 
WITH t SELECT FROM 

subtree »> RETURN [index]; 

ENDCASE «> ERROR 
END; 

shared: PROCEDURE [t: TreeLink] RETURNS [BOOLEAN] « 
BEGIN 
RETURN [WITH t SELECT FROM 

subtree »> IF index ■ nullTreelndex THEN FALSE ELSE (tb+index) . shared , 

ENDCASE -> FALSE] 
END; 
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setshared: PROCEDURE [t: TreeLink, shared: BOOLEAN] - 
BEGIN 
WITH t SELECT FROM 

subtree ■> IF index # nullTreelndex THEN (tb+index) . shared ♦• shared; 

ENDCASE; 
RETURN 
END; 

testtree: PROCEDURE [t: TreeLink, name: NodeName] RETURNS [BOOLEAN] ■ 
BEGIN 
RETURN [WITH t SELECT FROM 

subtree ■> index # nullTreelndex AND (tb+index) .name ■ name, 
ENDCASE ■> FALSE] 
END; 

SonCount: PRIVATE PROCEDURE [node: Treelndex] RETURNS [CARDINAL] - 
BEGIN 
RETURN [SELECT node FROM 

nullTreelndex, endTreelndex »> 0, 

ENDCASE ■> IF ( tb+node) .name « list AND (tb+node) .nsons ■ 
THEN 1 istlength[TreeLink[subtree[index: node]]] + 1 
ELSE (tb+node) .nsons] 
END; 

-- procedures for tree traversal 

UpdateTree: PROCEDURE [root: TreeLink, map: TreeMap] RETURNS [v: TreeLink] 
BEGIN 

node: Treelndex; 
nSons: CARDINAL; 
p: TreeXIndex; 
WITH root SELECT FROM 
subtree ■> 

BEGIN node *- index; 
IF node nullTreelndex 
THEN 
BEGIN 

nSons <- SonCount[node]; p <- LOOPHOLE[node + TreeNodeSize] ; 
THROUGH [1 . . nSons] 
DO 

IF (tb+p).soni # EndMark THEN (tb+p).soni «- map[(tb+p) . soni]; 
P «- P+1; 
ENDLOOP; 
END; 
v «- root; 
END; 
ENDCASE -> v <- map[root]; 
RETURN 
END; 

-- procedures for list testing 

listlength: PROCEDURE [t: TreeLink] RETURNS [CARDINAL] « 
BEGIN 

node: Treelndex; 
p: TreeXIndex; 
n: CARDINAL; 

IF t « empty THEN RETURN [0]; 
WITH t SELECT FROM 
subtree s > 

BEGIN node <- index; 

IF (tb+node). name # list THEN RETURN [1]; 

n «- (tb+node) .nsons; 

IF n H THEN RETURN [n]; 

FOR p *- LOOPHOLE[node+TreeNodeSize], p+1 UNTIL (tb+p).soni - EndMark 

DO n +- n + 1 ENDLOOP; 
RETURN [n] 
END; 
ENDCASE -> RETURN [1] 
END; 

listhead: PROCEDURE [t: TreeLink] RETURNS [TreeLink] ■ 
BEGIN 
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node: Treelndex; 
IF t ■ empty THEN ERROR; 
WITH t SELECT FROM 
subtree ■> 

BEGIN node <- index; 

IF (tb+node). name § list THEN RETURN [t]; 

IF (tb+node). sonl § EndMark THEN RETURN [(tb+node) . sonl]; 

ERROR 

END; 
ENDCASE -> RETURN [t] 
END; 

listtail: PROCEDURE [t: TreeLink] RETURNS [TreeLink] - 
BEGIN 

node: Treelndex; 
IF t •> empty THEN ERROR; 
WITH t SELECT FROM 
subtree »> 

BEGIN node «- index; 

IF (tb+node). name # list THEN RETURN [t]; 

IF (tb+node) .sonl # EndMark 

THEN RETURN [(tb + LOOPHOLE[node+TreeNodeSize+(l istlength[t]-l) , TreeXIndex]) . soni] ; 
ERROR 
END; 
ENDCASE «> RETURN [t] 
END; 

-- procedures for list traversal 

scanlist: PROCEDURE [root: TreeLink, action: TreeScan] ■ 
BEGIN 

node: Treelndex; 
p: TreeXIndex; 
n: CARDINAL; 
t: TreeLink; 
IF root # empty 
THEN 

WITH root SELECT FROM 
subtree a > 

BEGIN node <- index; 
IF (tb+node) .name # list 
THEN action[root] 
ELSE 

BEGIN p <- LOOPHOLE[node + TreeNodeSize]; 
IF (n «- (tb+node) .nsons) # 
THEN 

THROUGH [1 .. n] 

DO action[(tb+p).soni]; p «- p+1 ENDLOOP 
ELSE 

UNTIL (t*-(tb+p).soni) - EndMark 
DO action[t]; p «- p+1 ENDLOOP; 
END; 
END; 
ENDCASE => action[root]; 
RETURN 
END; 

reversescanl ist: PROCEDURE [root: TreeLink, action: TreeScan] ■ 
BEGIN 

node: Treelndex; 
p: TreeXIndex; 
n: CARDINAL; 
IF root # empty 
THEN 

WITH root SELECT FROM 
subtree ■> 

BEGIN node «- index; 
IF (tb+node) .name # list 
THEN action[root] 
ELSE 

BEGIN n «- 1istlength[root]; 

p <- LOOPHOLE[node + TreeNodeSize + n]; 

THROUGH [1 .. n] 

DO p ♦- p-1; action[(tb+p) .soni] ENDLOOP; 
END; 
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END; 
ENDCASE -> action[root]; 
RETURN 
END; 

update! ist: PROCEDURE [root: TreeLink, map: TreeMap] RETURNS [TreeLink] ■ 
BEGIN 

node: Treelndex; 
p: TreeXIndex; 
t: TreeLink; 
n: CARDINAL; 

IF root - empty THEN RETURN [empty]; 
WITH root SELECT FROM 
subtree ■> 

BEGIN node «- index; 

IF (tb+node). name # list THEN RETURN [map[root]]; 
p 4- LOOPHOLE[node + TreeNodeSize] ; 
IF (n 4- (tb+node) .nsons) # 
THEN 

THROUGH [1 . . n] 

DO (tb+p).soni «- map[(tb+p) . soni]; p 4- p+1 ENDLOOP 
ELSE 

UNTIL (t<-(tb+p).soni) - EndMark 

DO (tb+p).soni 4- map[t]; p 4- p+1 ENDLOOP; 
RETURN [root] 
END; 
ENDCASE ■> RETURN [map[root]]; 
END; 

reverseupdatel ist: PROCEDURE [root: TreeLink, map: TreeMap] RETURNS [TreeLink] 
BEGIN 

node: Treelndex; 
p: TreeXIndex; 
n: CARDINAL; 

IF root ■ empty THEN RETURN [empty]; 
WITH root SELECT FROM 
subtree »> 

BEGIN node «- index; 

IF (tb+node). name # list THEN RETURN [map[root]]; 

n <- listlength[root]; p <- LOOPHOLE[node + (TreeNodeSize + n)]; 

THROUGH [1 . . n] 

DO p <- p-1; (tb+p).soni 4- map[( tb+p) . soni] ENDLOOP; 
RETURN [root] 
END; 
ENDCASE • > RETURN [map[root]]; 
END; 

-- cross-table tree manipulation 

CopyTree: PROCEDURE [root: Treeld, map: TreeMap] RETURNS [v: TreeLink] * 
BEGIN 

sNode, dNode: Treelndex; 
size, nSons: CARDINAL; 
s, d: TreeXIndex; 
WITH root. link SELECT FROM 
subtree s > 

BEGIN sNode 4- index; 
IF sNode ■ nullTreelndex 
THEN v <- root. link 
ELSE 
BEGIN 

size 4- NodeSize[root.baseP, sNode]; nSons 4- size - TreeNodeSize; 
dNode 4- TableDefs.GetChunk[size]; 
s 4- LOOPHOLE[sNode + TreeNodeSize]; 
d 4- LOOPHOLE[dNode + TreeNodeSize]; 
THROUGH [1 . . nSons] 
DO 

(tb+d).soni 4- if (root.basePt + s).soni ■ EndMark 
THEN EndMark 

ELSE map[(root.basePt + s).soni]; 
s 4- s+1; d 4- cj+l; 
ENDLOOP; 
(tb+dNode) . name 4- (root.basePt + sNode).name; 
(tb+dNode) .mark 4- (root.basePt + sNodej.mark; 
(tb+dNode). shared 4- FALSE; 



TreePack.mesa 



2-Sep-78 12:59:59 



Page 8 



(tb+dNode) .nsons «- (root. basePt + sNode) .nsons; 

(tb+dNode) .info <- (root.basePt + sNode).info; 

(tb+dNode) .attrl <- (root.basePt + sNode) .attrl; 

(tb+dNode). attr2 <- (root.basePt + sNode) .attr2; 

v «- [subtree[index: dNode]]; 

END; 
END; 
ENDCASE ■> v «- map[root.1ink]; 
RETURN 
END; 

IdentityMap: TreeMap ■ 
BEGIN 
RETURN [IF t.tag « subtree AND ~shared[t] 

THEN CopyTree[[baseP:@tb, 1 ink: t] , IdentityMap] 

ELSE t] 
END; 

NodeSize: PROCEDURE [baseP: TableDef s.TableFinger , node: Treelndex] RETURNS [size: CARDINAL] 
BEGIN 

p: TreeXIndex; 
IF node » nullTreelndex 
THEN size «- 
ELSE 

IF (basePt + node). name # list OR (basePt + node). nsons # 
THEN size «- TreeNodeSize + (basePt + node). nsons 
ELSE 
BEGIN 

size *- TreeNodeSize + 1; p <- LOOPHOLE[node+TreeNodeSize]; 
UNTIL (basePt + p).soni - EndMark 

DO size <- size +1; p <- p + 1 ENDLOOP; 
END; 
RETURN 
END; 



END. 



